home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Dr. Windows 3
/
dr win3.zip
/
dr win3
/
WINICONS
/
V12N11.ZIP
/
QBDOS.BAS
< prev
next >
Wrap
BASIC Source File
|
1993-07-11
|
4KB
|
110 lines
'********** QBDOS.BAS - reads file names from disk
'Copyright (c) 1993 Ethan Winer
DEFINT A-Z
DECLARE FUNCTION GetAttr% (FileName$)
DECLARE FUNCTION SetAttr% (FileName$, Attribute)
DECLARE FUNCTION QBDir$ (FileSpec$)
DECLARE SUB Interrupt (IntNum, InRegs AS ANY, OutRegs AS ANY)
'---- Define the TYPE required by CALL INTERRUPT
TYPE RegType
AX AS INTEGER
BX AS INTEGER
CX AS INTEGER
DX AS INTEGER
BP AS INTEGER
SI AS INTEGER
DI AS INTEGER
Flags AS INTEGER
END TYPE
DIM SHARED DTA AS STRING * 44 'this is DOS' work area
DIM SHARED Regs AS RegType 'used by CALL Interrupt
DIM SHARED LocalSpec AS STRING * 80 'using a fixed-length string
' supports both QB and PDS
'======= Beginning of demonstration portion, remove the following code
' when adding this module to another program.
CLS
Path$ = "C:\QB45\" 'use "" for the current directory
Spec$ = Path$ + "*.*" 'find all matching files
DO
This$ = QBDir$(Spec$) 'read the name of first one
IF This$ = "" THEN EXIT DO 'none found, all done
PRINT This$; 'print the name
Attr = GetAttr%(Path$ + This$) 'read its attributes
IF Attr% AND 1 THEN PRINT SPC(1); "Read-only";
IF Attr% AND 2 THEN PRINT SPC(1); "Hidden";
IF Attr% AND 4 THEN PRINT SPC(1); "System";
IF Attr% AND 32 THEN PRINT SPC(1); "Archive";
PRINT 'kick out a new line
Spec$ = "" 'clear Spec$ to find the rest
LOOP
'======= END OF DEMO
FUNCTION GetAttr% (FileName$) STATIC
LocalSpec$ = FileName$ + CHR$(0) 'add a CHR$(0) for DOS
Regs.AX = &H4300 'get attribute sevice
Regs.DX = VARPTR(LocalSpec$) 'show DOS where the local copy is
CALL Interrupt(&H21, Regs, Regs) 'read the attributes
GetAttr% = Regs.CX AND &HFF 'assign the output
IF Regs.Flags AND 1 THEN 'oops, there was an error
GetAttr% = -1 'return -1 as a flag
END IF
END FUNCTION
FUNCTION QBDir$ (Spec$) STATIC 'reports if a file exists
LocalSpec$ = Spec$ + CHR$(0) 'add a CHR$(0) for DOS
Regs.AX = &H1A00 'assign DTA service
Regs.DX = VARPTR(DTA) 'show DOS where to place it
CALL Interrupt(&H21, Regs, Regs)
IF LEN(Spec$) THEN 'find first matching file
Regs.AX = &H4E00
ELSE
Regs.AX = &H4F00 'find subsequent file names
END IF
Regs.CX = 39 'any file attribute okay
Regs.DX = VARPTR(LocalSpec$) 'show DOS where the local copy is
CALL Interrupt(&H21, Regs, Regs) 'see if there's a match
QBDir$ = "" 'assume no matching file is present
IF (Regs.Flags AND 1) = 0 THEN 'if the Carry flag is clear, a
FileName$ = MID$(DTA, 31, 13) ' file was found and its name
Zero = INSTR(FileName$, CHR$(0)) ' is in the DTA with a trailing
QBDir$ = LEFT$(FileName$, Zero - 1) ' CHR$(0) byte, strip the zero
END IF
END FUNCTION
FUNCTION SetAttr% (FileName$, Attribute) STATIC
LocalSpec$ = FileName$ + CHR$(0) 'add a CHR$(0) for DOS
Regs.AX = &H4301 'set attribute sevice
Regs.CX = Attribute
Regs.DX = VARPTR(LocalSpec$) 'show DOS where the local copy is
CALL Interrupt(&H21, Regs, Regs) 'assign the new attributes
SetAttr% = 0
IF Regs.Flags AND 1 THEN 'oops, there was an error
SetAttr% = -1 'return -1 as a flag
END IF
END FUNCTION